home *** CD-ROM | disk | FTP | other *** search
/ Shareware Games Galore! / Shareware Games Galore!.iso / arcade / advsrc / adarr.for < prev    next >
Encoding:
Text File  |  1993-03-27  |  6.4 KB  |  173 lines
  1. C  Adventure Data Base Array Lister Program For Debugging Stuff--2byte
  2. c   Written for MS DOS PDS FORTRAN v5.10 
  3. c    by Paul Muñoz-Colman, FunStuff Software
  4. c   27 Mar 1993  
  5. c   12 August 1985
  6. C
  7. $NODEBUG
  8. $notstrict
  9. $storage: 2
  10.       IMPLICIT INTEGER*2 (A-Z)
  11.       character*4 wd1,wd2,iz,bl,atab(295),wd1x,wd2x
  12.       integer*4 travel(745),itk(20),newloc,linuse,kk,linsiz,ldex
  13.       integer*4 iwd2,ll,izz,index,linpt
  14. c
  15.       equivalence(iwd2,wd2),(izz,iz)
  16.       CHARACTER*2 LINES (21150)
  17.       CHARACTER*12 FNAME
  18.       CHARACTER*2 clines
  19.       character*3 lines3(2),out1(25),out2(26)
  20.       DIMENSION KTAB(295),RTEXT(205)
  21.       DIMENSION LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),
  22.      1          ATLOC(150)
  23.       DIMENSION PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),
  24.      1          PTEXT(100),PROP(100)
  25.       DIMENSION ACTSPK(35)
  26.       DIMENSION CTEXT(12),CVAL(12)
  27.       DIMENSION HINTLC(20),HINTED(20),HINTS(20,4)
  28.       DIMENSION MTEXT(35)
  29.       DIMENSION DSEEN(6),DLOC(6),ODLOC(6),HNAME(4)
  30.       INTEGER*2 IDONDX
  31. C
  32.       EQUIVALENCE(BL,IBL),(CLINES,ILINES)
  33. c
  34. c
  35.       open (1, file='ad.dat', form='unformatted')
  36. c
  37. c  read the data base in array format
  38. c
  39.       read (1) abbnum,axe,back,batter,bear,bird,bonus,bottle,
  40.      .  cage,cave,chain,chasm,chest,chloc,chloc2,clam,
  41.      .  clock1,clock2,closed,closng,coins,daltlc,detail,dflag,
  42.      .  dkill,dloc,door,dprssn,dragon,dseen,dwarf,eggs,
  43.      .  emrald,entrnc,find,fissur,foobar,food,gaveup,grate
  44. c
  45.       read (1) invent,iwest,keys,knfloc,knife,lamp,lmwarn,
  46.      .  lock,look,magzin,maxdie,maxtrs,messag,mirror,nugget,
  47.      .  null,numdie,oil,oyster,panic,pearl,pillow,plant,
  48.      .  plant2,pyram,rod,rod2,rug,saved,say,scorng,
  49.      .  snake,spices,steps,tablet,tally,tally2,throw,tridnt,
  50.      .  troll,troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,fixed
  51. c
  52.       read (1) linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,
  53.      .  k,j,stext,ltext,ptext,rtext,ctext,cval,key,
  54.      .  travel,ktab,plac,fixd,actspk,cond,hints,place,prop,link,
  55.      .  abb,atloc,holdng,hinted,hintlc,kk,i,itk,atab,lines
  56. c
  57.       close (1)
  58.  
  59.       write (*,30)
  60. 30    format ('1travel',//)
  61. c
  62.       do 28 itv=1,149
  63. 28    write (*,29) (travel(jt),jt=((itv-1)*5+1),((itv-1)*5+5)),itv*5
  64. 29    format (5i14,i6)
  65. c
  66. c  now do lines array
  67.     open (3,file='temp',status='unknown')
  68.     write (*,31)
  69. 31    format ('1lines',//)
  70. c
  71.     linpt=1
  72.     index=0
  73.   2    index=index+25
  74. c  don't let array index overflow please
  75.     if (ilines.eq.-1) go to 4
  76. c  find place in output line for array pointer label
  77. c  clear the two output lines
  78.     do 20 pp=1,26
  79.     if (pp .le. 25) out1(pp)='   '
  80. 20    out2(pp)='   '
  81. c  fill up the output line with the 25 lines words
  82.     do 25 ll=1,25
  83.     ldex=index-25+ll
  84. 25    out1(ll)=lines(ldex)
  85. c  check if index value needs to be put in output line
  86. 23     if (ilines.eq.-1.or.linpt.gt.index) go to 21
  87.  
  88. c  found current index pointer that belongs in this output line
  89. c  write out as integer and reread as 2a3
  90.     clines=lines(linpt)
  91.         write (3,5) ilines
  92. 5    format (i6)
  93.         rewind 3
  94.       read (3,6) lines3
  95. 6    format (2a3)
  96.     rewind 3
  97. c  compute place in verbage and numerics output lines
  98.     sing=(mod(iabs(linpt),25))
  99.     if (sing.eq.0) sing=25
  100. c  fill numerics output line with 2a3
  101.     do 22 til=1,2
  102.     if (til.eq.1.and.ilines.lt.0) out1 (sing)='## '
  103.     if (til.eq.1.and.ilines.gt.0) out1 (sing)='// '
  104. 22    out2(sing+til-1)=lines3(til)
  105. c  get next pointer
  106.     if (ilines .ne. -1) linpt=iabs(ilines)
  107.     go to 23
  108. c  write output lines now
  109. 21    write (*,26) (out1(mm),mm=1,25),index
  110. 26    format (3x,25a3,i6)
  111.     write (*,41) (out2(mm),mm=1,26)
  112. 41    format (1x,26a3)
  113. c  do it again for the next line
  114.     go to 2
  115. c
  116. c
  117. 4      write(*,10) abbnum,axe,back,batter,bear,bird,bonus,bottle,
  118.      .  cage,cave,chain,chasm,chest,chloc,chloc2,clam,
  119.      .  clock1,clock2,closed,closng,coins,daltlc,detail,dflag,
  120.      .  dkill,dloc,door,dprssn,dragon,dseen,dwarf,eggs,
  121.      .  emrald,entrnc,find,fissur,foobar,food,gaveup,grate
  122. c
  123. 10      format ('1abbnum,axe,back,batter,bear,bird,bonus,bottle,',
  124.      .  'cage,cave'//,10i8,//,' chain,chasm,chest,chloc,chloc2,clam,',
  125.      .'clock1,clock2,closed,closng'//10i8//,' coins,daltlc,detail,dfla'
  126.      .,'g,dkill',//,5i8,//,' dloc',//,6i8,//,
  127.      . ' door,dprssn,dragon',//,3i8,//,' dseen'//6i8//,' dwarf,eggs,',
  128.      .'emrald,entrnc,find,fissur,foobar,food,gaveup,grate',//,10i8,//)
  129. c
  130.       write(*,11)invent,iwest,keys,knfloc,knife,lamp,lmwarn,
  131.      .  lock,look,magzin,maxdie,maxtrs,messag,mirror,nugget,
  132.      .  null,numdie,oil,oyster,panic,pearl,pillow,plant,
  133.      .  plant2,pyram,rod,rod2,rug,saved,say,scorng,
  134.      .  snake,spices,steps,tablet,tally,tally2,throw,tridnt,
  135.      .  troll,troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,fixed
  136. c
  137. 11    format (' invent,iwest,keys,knfloc,knife,lamp,lmwarn,',
  138.      .'lock,look,magzin'//10i8//' maxdie,maxtrs,messag,mirror,nugget,',
  139.      .'null,numdie,oil,oyster,panic',//,10i8,//,' pearl,pillow,plant,',
  140.      . 'plant2,pyram,rod,rod2,rug,saved,say',//,10i8,//,' scorng',
  141.      .',snake,spices,steps,tablet,tally,tally2,throw,tridnt,',
  142.      . 'troll',//,10i8,//,
  143.      .' troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,',//,
  144.      .  8i8,//,' fixed',//,10(10i8/),//)
  145. c
  146.       write(*,  1)linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,
  147.      .  k,j
  148.   1   format (' linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,'
  149.      . ,/,'  k,j,',//,9i8,/,2i8,//)
  150.       write (*,  9) stext,ltext,ptext,rtext,ctext,cval,key,
  151.      .         atab,ktab,plac,fixd,actspk,cond,hints
  152.   9   format (
  153.      .  ' stext',//,15(10i8/),//,' ltext',//,15(10i8/),//,' ptext',//,
  154.      .  10(10i8/),//,' rtext',//,20(10i8/),5i8,//,' ctext',//,10i8,/,
  155.      .2i8,//,' cval'//10i8,/,2i8,//,' key'//15(10i8/),//,
  156.      .                     ' atab'//29(1x,10(a4,2x)/),1x,5(a4,2x),//,
  157.      .  ' ktab'//29(10i8/),5i8,//,' plac',//,10(10i8/),//,' fixd',//,
  158.      .  10(10i8/),//,' actspk',//,3(10i8/),5i8,//,
  159.      .  ' cond',//,15(10i8/),//,' hints',//,8(10i8/),//)
  160. c
  161.       write (*,12) place,prop,link,
  162.      .  abb,atloc,holdng,hinted,hintlc,kk,i,itk
  163. c
  164. 12    format (' place',//,10(10i8/),//,' prop',//,10(10i8/),//,
  165.      .  ' link',//,20(10i8/),//,' abb',//,15(10i8/),//,' atloc',//,
  166.      .  15(10i8/),//,' holdng',i8,//,' hinted',//,2(10i8/),//,
  167.      .  ' hintlc',//,2(10i8/),//,' kk',i8,//,' i',//,i8,//,' itk',//,
  168.      .  2(10i8/),//)
  169. c
  170.         write (*,27)
  171.   27    format (1h1,'=================  END  ================'///)
  172.     end
  173.